; ORIGINAL: 3dt2.1/examples/setview.scm
; $Id: setview.scm,v 1.3 1996/10/21 15:59:34 aed Exp $
;======================================================================
; Purpose---
;    Define procedures for setting standard views
;
;======================================================================

(provide 'setview)

;; view control

(define make-view-proc
  (lambda (dx dy dz ux uy uz)
    (let ((dir (gvector dx dy dz "model"))
          (up (gvector ux uy uz "model")))
      (lambda v
        (let ((view (if (not (null? v)) (car v) (env:active-view))))
          (let* ((target (view:target view))
                 (distance (position:distance target (view:eye view)))
                 (eye (position:offset
                        target
                        (gvector:scale (gvector:unitize dir) distance)))
                 )
            (view:set eye target up view)
            (view:refresh view)
            ))))))

(define iso (make-view-proc 1 -2 1 0 0 1))
(define top (make-view-proc 0 0 1 0 1 0))
(define front (make-view-proc 0 -1 0 0 0 1))
(define right (make-view-proc 1 0 0 0 0 1))

(define (repaint)
  (for-each view:refresh (env:views)))

;; This procedure will re-center the view so that the "center"
;; of the model is the view target position
(define (recenter-view . v)
  (let ((view (if (not (null? v)) (car v) (env:active-view))))
    (let* ((box (entity:box (part:entities (view:part view))))
           (center (position:interpolate (car box) (cdr box) .5))
           (dir (gvector:from-to (view:target view) (view:eye view)))
           )
      (view:set-target center view)
      (view:set-eye (position:offset (view:target view) dir))
      (view:refresh view)
      )))

